perm filename BARS.F4[RST,LCS] blob sn#239709 filedate 1976-10-05 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		DIMENSION A(510),LN(50),KBAR(512)
C00005 ENDMK
CāŠ—;
	DIMENSION A(510),LN(50),KBAR(512)
	EQUIVALENCE (KT,KBAR),(TX,KBAR(2)),(A,KBAR(3))
	DATA DIV/4.0/
	CALL GETFIL('BARS')
	CALL FASTIN(KBAR,512)
15	TYPE 10,KT,TX
10	FORMAT(' BARS=',I3,'  SPACE=',F9.2/' HOW MANY LINES  '$)
	ACCEPT 11,T
11	FORMAT(5F)
17	B=0
	DO 16 K=1,KT
16	B=B+A(K)
	AV=B/T
	X=AV
	JT=T
	NN=KT/JT
	NX=KT-NN*JT
	DO 308 K=1,JT-NX
C  NN=AVG. NUM OF BARS/LINE
308	LN(K)=NN
	IF(NX.EQ.0)GO TO 309
	DO 310 K=JT-NX+1,JT
310	LN(K)=NN+1
	J=0
309	DO 311 K=1,JT
	L=LN(K)
	B=0
	DO 312 KK=1,L
	J=J+1
312	B=B+A(J)
	IF(K.EQ.1)GO TO 311
	

311	T=B
	J=0
	K=0
7	Y=0
	LAST=J
	N=0
	M=J+1
1	J=J+1
	N=N+1
	Y=Y+A(J)
	IF(J.EQ.KT)GO TO 2
	IF(Y.LE.X)GO TO 1
3	IF(Y-X.LT.X-Y+A(J))GO TO 2
	Y=Y-A(J)
	J=J-1
	N=N-1
2	X=X+(X-Y)/DIV
	K=K+1
	LN(K)=N
	B=ABS(Y-T)
	IF(K.EQ.1)GO TO 9
	IF(Y.LT.T)GO TO 22
C NEXT TO SHIFT BAR TO NEXT OR PREV. LINE IF DESIRED.
	IF(B.GT.A(M))GO TO 21
	GO TO 9
22	IF(B.LE.A(LAST))GO TO 9
	IF(Y.GT.T)GO TO 20
	JK=K-1
	JJ=K
	B=A(LAST)
	GO TO 20
21	JJ=K-1
	JK=K
	B=-A(M)
20	LN(JJ)=LN(JJ)+1
C  SHIFT BAR FROM ONE LINE TO OTHER IF DESIRED
	LN(JK)=LN(JK)-1
	Y=Y+B
9	T=Y
	IF(J.LT.KT)GO TO 7
	J=1
	TYPE 6,AV
	DO 5 K=1,JT
	L=LN(K)-1+J
	T=0
	DO 8 M=J,L
8	T=T+A(M)
	TYPE 6,(A(N),N=J,L),T
5	J=L+1
6	FORMAT(1X8F6.2)
	GO TO 15
	END